﻿Imports System.Data.SqlClient
Imports System.Data.OleDb
Imports System.Data.Common
Imports System.ComponentModel
Imports System.Runtime.CompilerServices
Imports System.IO

Public MustInherit Class Connection

    Dim Valid As String

    Sub New()
        For i As Integer = Asc("A") To Asc("Z")
            Valid &= Chr(i) & Chr(32 + i)
        Next i
        Valid &= "~0123456789üğışöçÜĞİŞÖÇ_"
    End Sub

    MustOverride Function OpenSQL(ByVal Text As String, ByVal ParamArray Args() As Object) As Recordset
    MustOverride Sub ExecSQL(ByVal Text As String, ByVal ParamArray Args() As Object)

    Overridable Sub EnsureTable(ByVal Table As String, ByVal PrimaryKey As String, ByVal Fields As String)
    End Sub

    <DebuggerHidden()> _
    Protected Sub InsertArguments(ByVal Command As DbCommand, ByVal Text As String, ByVal ParamArray Args() As Object)
        Dim ParamList As New List(Of String)
        Dim Pos As Integer = 0
        Do
            Pos = InStr(Pos + 1, Text, "@")
            If Pos = 0 Then Exit Do
            Dim ParamName As String = "@"
            For j = Pos + 1 To Len(Text)
                If InStr(Valid, Mid(Text, j, 1)) = 0 Then Exit For
                ParamName &= Mid(Text, j, 1)
            Next j
            If Not ParamList.Contains(ParamName) Then ParamList.Add(ParamName)
        Loop
        For i = 0 To UBound(Args)
            Dim Parameter = Command.CreateParameter
            Parameter.ParameterName = ParamList(i)
            Parameter.Value = Args(i)
            Command.Parameters.Add(Parameter)
        Next
    End Sub

End Class

Public Class SQLServerConnection : Inherits Connection

    Dim Connection As SqlConnection
    Dim Server, Database As String

    <DebuggerHidden()> _
    Sub New(ByVal Server As String, ByVal Database As String, ByVal UserID As String, ByVal Password As String, Optional ByVal ApplicationName As String = "")
        MyBase.New()
        Dim cs As String = ConnectionString(Server, Database, UserID, Password, ApplicationName)
        Connection = New SqlConnection(cs)
        Connection.Open()
        ActiveConnection = Me
    End Sub

    <DebuggerHidden()> _
    Public Overrides Function OpenSQL(ByVal Text As String, ByVal ParamArray Args() As Object) As Recordset
        If Not Text.Contains("@") Then Text = Text.Replace(":~", ":").Replace(":", "@")
        Dim Adapter As New SqlDataAdapter(Text, Connection)
        Dim CmdBuilder As New SqlCommandBuilder(Adapter)
        InsertArguments(Adapter.SelectCommand, Text, Args)
        Adapter.SelectCommand.CommandTimeout = 120
        Return New Recordset(Adapter)
    End Function

    <DebuggerHidden()> _
    Public Overrides Sub ExecSQL(ByVal Text As String, ByVal ParamArray Args() As Object)
        If Not Text.Contains("@") Then Text = Text.Replace(":~", ":").Replace(":", "@")
        Dim Command As New SqlCommand With {.Connection = Connection, .CommandText = Text}
        InsertArguments(Command, Text, Args)
        Command.ExecuteNonQuery()
    End Sub

    Shared Function ConnectionString(ByVal Server As String, ByVal Database As String, ByVal UserID As String, ByVal Password As String, Optional ByVal ApplicationName As String = "")
        Return "application name=" & ApplicationName & ";data source=" & Server & ";user id=" & UserID & ";password=" & Password & ";database=" & Database & ";connection timeout=5"
    End Function

End Class

Public Class AccessConnection : Inherits Connection

    Dim Connection As OleDbConnection
    Dim Server, Database As String

    Sub New(ByVal Path As String)
        MyBase.New()
        Dim cs As String = ConnectionString(Path)
        Connection = New OleDbConnection(cs)
        Connection.Open()
        ActiveConnection = Me
    End Sub

    <DebuggerHidden()> _
    Public Overrides Function OpenSQL(ByVal Text As String, ByVal ParamArray Args() As Object) As Recordset
        If Not Text.Contains("@") Then Text = Text.Replace(":~", ":").Replace(":", "@")
        Dim Adapter As New OleDbDataAdapter(Text, Connection)
        Dim CmdBuilder As New OleDbCommandBuilder(Adapter)
        InsertArguments(Adapter.SelectCommand, Text, Args)
        Adapter.SelectCommand.CommandTimeout = 120
        Return New Recordset(Adapter)
    End Function

    '<DebuggerHidden()> _
    Public Overrides Sub ExecSQL(ByVal Text As String, ByVal ParamArray Args() As Object)
        If Not Text.Contains("@") Then Text = Text.Replace(":~", ":").Replace(":", "@")
        Dim Command As New OleDbCommand With {.Connection = Connection, .CommandText = Text}
        InsertArguments(Command, Text, Args)
        Try
            Command.ExecuteNonQuery()
        Catch ex As Exception
            Application.DoEvents()
        End Try
    End Sub

    Public Overrides Sub EnsureTable(ByVal Table As String, ByVal PrimaryKey As String, ByVal Fields As String)
        Dim Schema = Connection.GetSchema("Tables")
        If Schema.Select("TABLE_NAME='" & Table & "'").Count = 0 Then
            ExecSQL("create table " & Table & " (" & PrimaryKey & ")")
        End If
        Schema = Connection.GetSchema("Columns")
        For Each Item In Fields.Split(",")
            Dim Data = Item.Split("(")
            If Schema.Select("TABLE_NAME='" & Table & "' and COLUMN_NAME='" & Data(0) & "'").Count = 0 Then
                Dim Type = ""
                Select Case Data(1)(0)
                    Case "t" : Type = "text"
                    Case "d" : Type = "date"
                    Case "i" : Type = "int"
                End Select
                ExecSQL("alter table " & Table & " add column " & Data(0) & " " & Type)
            End If
        Next
    End Sub

    Shared Function ConnectionString(ByVal Path As String)
        Return "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Path '& ";User Id=admin;Password=;"
    End Function

End Class

Public Module SQLExtensions

    Public ActiveConnection As Connection
    Public Null As DBNull = DBNull.Value

    Dim Buffer As String = ""

	Public Sub Q(ByVal Text As String, ParamArray Args() As Object)
		If Args.Length > 0 Then
			Dim i = 0
			Do
				Dim Pos1 = InStr(Text, "@")
				If Pos1 = 0 Then Exit Do
				Dim Pos2 = Pos1 + 1
				Do Until Not Char.IsLetterOrDigit(Mid(Text, Pos2, 1))
					Pos2 += 1
				Loop
				Text = Mid(Text, 1, Pos1 - 1) & Args(i) & Mid(Text, Pos2)
				i += 1
			Loop
		End If
		Buffer &= Text & vbCrLf
	End Sub

	Function GetBuffer() As String
		Dim Text = Buffer
		Buffer = ""
		Return Text
	End Function

    Public Function OpenSQL(ByVal Text As String, ByVal ParamArray Args() As Object) As Recordset
        If Text = "*" Then Text = Buffer : Buffer = ""
        Return ActiveConnection.OpenSQL(Text, Args)
    End Function

    Public Sub ExecSQL(ByVal Text As String, ByVal ParamArray Args() As Object)
        If Text = "*" Then Text = Buffer : Buffer = ""
        ActiveConnection.ExecSQL(Text, Args)
    End Sub

    <DebuggerHidden()> _
    Public Sub OpenConnection(ByVal SQLServer As String, ByVal Database As String, ByVal UserID As String, ByVal Password As String, Optional ByVal ApplicationName As String = "")
        ActiveConnection = New SQLServerConnection(SQLServer, Database, UserID, Password, ApplicationName)
    End Sub

    Public Sub OpenConnection(ByVal AccessDBPath As String)
        ActiveConnection = New AccessConnection(AccessDBPath)
    End Sub

    Public Sub CreateDatabase(ByVal AccessDBPath As String)
        My.Computer.FileSystem.WriteAllBytes(AccessDBPath, My.Resources.db, False)
        OpenConnection(AccessDBPath)
    End Sub

    Public Sub EnsureDatabase(ByVal AccessDBPath As String)
        If Not My.Computer.FileSystem.FileExists(AccessDBPath) Then CreateDatabase(AccessDBPath)
        OpenConnection(AccessDBPath)
    End Sub

    Sub EnsureTable(ByVal Table As String, ByVal PrimaryKey As String, ByVal Fields As String)
        ActiveConnection.EnsureTable(Table, PrimaryKey, Fields)
    End Sub

    <Extension()> _
    Sub Open(ByRef Rs As Recordset, ByVal Text As String, ByVal ParamArray Args() As Object)
        Rs = OpenSQL(Text, Args)
    End Sub

End Module

